FAIRE DES CARTES DE FLUX DANS R
Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum has been the industry’s standard dummy text ever since the 1500s, when an unknown printer took a galley of type and scrambled it to make a type specimen book. It has survived not only five centuries, but also the leap into electronic typesetting, remaining essentially unchanged. It was popularised in the 1960s with the release of Letraset sheets containing Lorem Ipsum passages, and more recently with desktop publishing software like Aldus PageMaker including versions of Lorem Ipsum.
Les données
Jeu de données sur les migrations internationales. Migration Stock at subregional level, 2019 Source : United Nations, Department of Economic and Social Affairs, Population Division (2019). Voir
Les packages
install.packages("sf")
install.packages("remotes")
install.packages("smoothr")
library(remotes)
install_github("riatelab/mapsf")
install_github("tributetotobler/ttt")library("sf")
library("mapsf")
library("ttt")Import et mise en forme des données
Données géométriques
countries <- st_read("data/world/geom/countries.gpkg")
graticule <- st_read("data/world/geom/graticule.gpkg")
bbox <- st_read("data/world/geom/bbox.gpkg")
crs <-
"+proj=aeqd +lat_0=90 +lon_0=50 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs "
countries <- st_transform(x = countries, crs = crs)
graticule <- st_transform(x = graticule, crs = crs)
bbox <- st_transform(x = bbox, crs = crs)
land <- st_union(countries)Données attributaires
migr <- read.csv("data/world/fij/migr2019_T.csv")Template cartographique
col = "#ffc524"
credit = paste0(
"Françoise Bahoken & Nicolas Lambert, 2021\n",
"Source: United Nations, Department of Economic\n",
"and Social Affairs, Population Division (2019)"
)
# theme = mf_theme(x = "default", bg = "white", tab = FALSE,
# pos = "center", line = 2, inner = FALSE,
# fg = "#9F204270", mar = c(0,0, 2, 0),cex = 1.9)
theme <- mf_theme(
x = "default",
bg = "#3b3b3b",
fg = "#ffc524",
mar = c(0, 0, 2, 0),
tab = TRUE,
pos = "left",
inner = FALSE,
line = 2,
cex = 1.9,
font = 3
)
template = function(title, file) {
mf_export(
countries,
export = "png",
width = 1000,
filename = file,
res = 96,
theme = theme,
expandBB = c(-.02, 0, -.02, 0)
)
mf_map(
bbox,
col = "#3b3b3b",
border = NA,
lwd = 0.5,
add = TRUE
)
mf_map(graticule,
col = "#FFFFFF50",
lwd = 0.5,
add = TRUE)
mf_map(
countries,
col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
# mf_map(links, col = NA,border = "#317691", lwd = 0.5, add = TRUE)
mf_credits(
txt = credit,
pos = "bottomright",
col = "#1a2640",
cex = 0.7,
font = 3,
bg = "#ffffff30"
)
mf_title(title)
}template("Template cartographique", "maps/template.png")
dev.off()Ce qu’on peut faire en R base & mapsf
L’effet Spaghetti
links <-
mf_get_links(
x = countries,
df = migr,
x_id = "adm0_a3_is",
df_id = c("i", "j")
)template("L'effet Spaghetti ", "maps/spaghetti.png")
mf_map(links, col = col, add = TRUE)
mf_map(land,
col = NA,
border = "#3b3b3b",
add = TRUE)
dev.off()Sélectionner un seul pays
Choix d’un pays
ISO3 <- "FRA"
label = "France"Jointure et mise en forme des données
countr <- countries[, c("adm0_a3_is", "label")]
migrFRA <- migr[migr$j == ISO3, ]
migrFRA$fij <- as.numeric(migrFRA$fij)
maxval = max(migrFRA$fij)
total = round(sum(migrFRA$fij) / 1000000,1)
countr <-
merge(
x = countr,
y = migrFRA,
by.x = "adm0_a3_is",
by.y = "i",
all.x = TRUE
)
countr <- countr[-3]
colnames(countr) <- c("id", "label", "fij", "geometry")knitr::kable(countr[c(0:10),], row.names = F, digits = 1)| id | label | fij | geometry |
|---|---|---|---|
| ABW | Aruba | 11 | MULTIPOLYGON (((-7476945 42… |
| AFG | Afghanistan | 6887 | MULTIPOLYGON (((2474775 -53… |
| AGO | Angola | 23438 | MULTIPOLYGON (((-4917506 -1… |
| AIA | Anguilla | 10 | MULTIPOLYGON (((-7351488 31… |
| ALB | Albania | 7371 | MULTIPOLYGON (((-2639654 -4… |
| AND | Andorra | 1079 | MULTIPOLYGON (((-3952645 -3… |
| ARE | United Arab Emirates | 862 | MULTIPOLYGON (((785851 -712… |
| ARG | Argentina | 14253 | MULTIPOLYGON (((-14113355 7… |
| ARM | Armenia | 21012 | MULTIPOLYGON (((-348529.3 -… |
| ASM | American Samoa | 1 | MULTIPOLYGON (((7561304 878… |
Une première carte simple
template(paste0("En 2019, il y avait ",total, " millions d'étrangers en France"),
"maps/prop1.png")
#mf_map(countr[countr$id == ISO3,], col = col, border = "red", lwd = 2, add = TRUE)
mf_map(
countr[countr$id != ISO3, ],
var = "fij",
col = col,
border = "white",
type = "prop",
val_max = maxval,
inches = 0.4,
leg_title_cex = 1.2,
leg_val_cex = 0.8,
leg_pos = "bottomleft",
leg_title = "Nombre de personnes"
)
mf_map(
countr[countr$id == ISO3, ],
col = NA,
border = "#e36019",
lwd = 2,
add = TRUE
)
dev.off()La carte symétrique
countr <- countries[, c("adm0_a3_is", "label")]
migrFRA <- migr[migr$i == ISO3, ]
migrFRA$fij <- as.numeric(migrFRA$fij)
total = round(sum(migrFRA$fij) / 1000000,1)
countr <-
merge(
x = countr,
y = migrFRA,
by.x = "adm0_a3_is",
by.y = "j",
all.x = TRUE
)
countr <- countr[-3]
colnames(countr) <- c("id", "label", "fij", "geometry")template(paste0("En 2019, il y avait ",total, " millions de Français à l'étranger"),
"maps/prop2.png")
mf_map(
countr[countr$id != ISO3, ],
var = "fij",
col = col,
border = "white",
type = "prop",
val_max = maxval,
inches = 0.4,
leg_title_cex = 1.2,
leg_val_cex = 0.8,
leg_pos = "bottomleft",
leg_title = "Nombre de personnes"
)
mf_map(
countr[countr$id == ISO3, ],
col = NA,
border = "#e36019",
lwd = 2,
add = TRUE
)
dev.off()On peut faire la même carte en faisant varier l’épaisseur des liens
ISO3 <- "FRA"
label = "France"
migrtoFRA <- migr[migr$j == ISO3,]
migrtoFRA$fij <- as.numeric(migrtoFRA$fij)links <-
mf_get_links(
x = countries,
df = migrtoFRA,
x_id = "adm0_a3_is",
df_id = c("i", "j")
)template(
paste0("Origine des personnes migrantes vivant en ", label, " en 2019"),
"maps/links1.png"
)
mf_map(
links,
var = "fij",
col = col,
border = "white",
type = "prop",
inches = 10,
leg_title_cex = 1.2,
leg_val_cex = 0.8,
leg_pos = "bottomleft",
leg_title = "Nombre de personnes"
)
mf_map(
countries[countries$adm0_a3_is == ISO3,],
col = "#4e4f4f",
border = col,
lwd = 1.5,
add = TRUE
)
dev.off()Une carte un peu plus sophistiquée avec packcircles
ISO3 <- "FRA"
label = "France"
migrFRA <- migr[migr$j == ISO3,]
migrFRA$fij <- as.numeric(migrFRA$fij)
migrFRA <-
rbind.data.frame(migrFRA, c(
i = ISO3,
j = ISO3,
fij = sum(as.numeric(migrFRA$fij))
))
countr <- countries[, "adm0_a3_is"]
countr <-
merge(
x = countr,
y = migrFRA,
by.x = "adm0_a3_is",
by.y = "i",
all.x = TRUE
)
colnames(countr) <- c("i", "j", "fij", "geometry")knitr::kable(countr[c(0:10),], row.names = F, digits = 1)| i | j | fij | geometry |
|---|---|---|---|
| ABW | FRA | 11 | MULTIPOLYGON (((-7476945 42… |
| AFG | FRA | 6887 | MULTIPOLYGON (((2474775 -53… |
| AGO | FRA | 23438 | MULTIPOLYGON (((-4917506 -1… |
| AIA | FRA | 10 | MULTIPOLYGON (((-7351488 31… |
| ALB | FRA | 7371 | MULTIPOLYGON (((-2639654 -4… |
| AND | FRA | 1079 | MULTIPOLYGON (((-3952645 -3… |
| ARE | FRA | 862 | MULTIPOLYGON (((785851 -712… |
| ARG | FRA | 14253 | MULTIPOLYGON (((-14113355 7… |
| ARM | FRA | 21012 | MULTIPOLYGON (((-348529.3 -… |
| ASM | FRA | 1 | MULTIPOLYGON (((7561304 878… |
Cercles avec packcircles (Dorling style)
library(packcircles)dots = countr
st_geometry(dots) <-
st_centroid(sf::st_geometry(dots), of_largest_polygon = TRUE)
dots <- data.frame(dots$i, dots["fij"], st_coordinates(dots))
dots = dots[, c("dots.i", "X", "Y", "fij")]
colnames(dots) <- c("id", "x", "y", "v")
dots <- dots[!is.na(dots$v), ]
k = 700000 # pour ajuster la taille des cercles
itermax = 10 # nombre d'iterations
delta = 35000
dat.init <- dots[, c("x", "y", "v", "id")]
dat.init$v <- sqrt(as.numeric(dat.init$v) * k)
simulation <- circleRepelLayout(
x = dat.init,
xysizecols = 1:3,
wrap = FALSE,
sizetype = "radius",
maxiter = itermax,
weights = 1
)$layout
circles <- st_buffer(sf::st_as_sf(
simulation,
coords = c('x', 'y'),
crs = sf::st_crs(countries)
),
dist = simulation$radius - delta)
circles$v = dots$v
circles$id = dots$idLinks
# Links
dots$j = "FRA"
links <-
mf_get_links(
x = circles,
df = migrFRA,
x_id = "id",
df_id = c("i", "j")
)
links$fij = as.numeric(links$fij)Réalisation de la carte
template("Les étrangers en France, 2019", "maps/migrexplorer1.png")
col2 = "#4e4f4f"
mf_map(
land,
col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
mf_map(
links,
var = "fij",
col = col,
border = "#3b3b3b",
type = "prop",
lwd_max = 160,
leg_pos = "n",
add = TRUE
)
mf_map(
circles[circles$id != ISO3, ],
var = "fij",
col = col,
border = "#3b3b3b",
lwd = 1.5,
add = TRUE
)
mf_map(
circles[circles$id == ISO3, ],
var = "fij",
col = col2,
border = col,
lwd = 2.5,
add = TRUE
)
t = circles[circles$id != ISO3, ]
mf_label(
t,
var = "id",
halo = FALSE,
cex = sqrt(as.numeric(t$v) / 1200000),
col = col2,
overlap = TRUE,
lines = FALSE
)
t = circles[circles$id == ISO3, ]
mf_label(
t,
var = "id",
halo = FALSE,
cex = sqrt(as.numeric(t$v) / 1200000),
col = col,
overlap = TRUE,
lines = FALSE
)
dev.off()Comme précédemment, on peut faire la carte en symétrie en inversant i et j.
ISO3 <- "FRA"
label = "France"
migrFRA <- migr[migr$i == ISO3,] # ici
migrFRA$fij <- as.numeric(migrFRA$fij)
migrFRA <-
rbind.data.frame(migrFRA, c(
i = ISO3,
j = ISO3,
fij = sum(as.numeric(migrFRA$fij))
))
countr <- countries[, "adm0_a3_is"]
countr <-
merge(
x = countr,
y = migrFRA,
by.x = "adm0_a3_is",
by.y = "j", # là
all.x = TRUE
)
colnames(countr) <- c("i", "j", "fij", "geometry")dots = countr
st_geometry(dots) <-
st_centroid(sf::st_geometry(dots), of_largest_polygon = TRUE)
dots <- data.frame(dots$i, dots["fij"], st_coordinates(dots))
dots = dots[, c("dots.i", "X", "Y", "fij")]
colnames(dots) <- c("id", "x", "y", "v")
dots <- dots[!is.na(dots$v), ]
k = 700000 # pour ajuster la taille des cercles
itermax = 10 # nombre d'iterations
delta = 35000
dat.init <- dots[, c("x", "y", "v", "id")]
dat.init$v <- sqrt(as.numeric(dat.init$v) * k)
simulation <- circleRepelLayout(
x = dat.init,
xysizecols = 1:3,
wrap = FALSE,
sizetype = "radius",
maxiter = itermax,
weights = 1
)$layout
circles <- st_buffer(sf::st_as_sf(
simulation,
coords = c('x', 'y'),
crs = sf::st_crs(countries)
),
dist = simulation$radius - delta)
circles$v = dots$v
circles$id = dots$idLinks
# Links
dots$j = "FRA"
links <-
mf_get_links(
x = circles,
df = migrFRA,
x_id = "id",
df_id = c("i", "j")
)
links$fij = as.numeric(links$fij)Réalisation de la carte
template("Les français à l'étranger, 2019", "maps/migrexplorer2.png")
col2 = "#4e4f4f"
mf_map(
land,
col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
mf_map(
links,
var = "fij",
col = col,
border = "#3b3b3b",
type = "prop",
lwd_max = 160,
leg_pos = "n",
add = TRUE
)
mf_map(
circles[circles$id != ISO3, ],
var = "fij",
col = col,
border = "#3b3b3b",
lwd = 1.5,
add = TRUE
)
mf_map(
circles[circles$id == ISO3, ],
var = "fij",
col = col2,
border = col,
lwd = 2.5,
add = TRUE
)
t = circles[circles$id != ISO3, ]
mf_label(
t,
var = "id",
halo = FALSE,
cex = sqrt(as.numeric(t$v) / 1200000),
col = col2,
overlap = TRUE,
lines = FALSE
)
t = circles[circles$id == ISO3, ]
mf_label(
t,
var = "id",
halo = FALSE,
cex = sqrt(as.numeric(t$v) / 1200000),
col = col,
overlap = TRUE,
lines = FALSE
)
dev.off()Ces cartes, on peut les retrouver dans l’application MigrExplorer mise en ligne via R shiny.
https://gitlab.huma-num.fr/nlambert/migrexplorer/-/tree/master
Changer de maillage
Contrairement aux cartes pays * pays, cartographier les flux au niveau régional permet de mieux percevoir la logique des mobilités internationales. Cette carte, pas très élégantes, a été réalisée et présentée par François Héron pour ses cours au Collège de France.
Et si on esseyait de la reproduire en R ?
Pour celà, nous fabriquons des données au niveau subrégional à partir d’une clé d’aggrégations contenu dans le ficher countries.
knitr::kable(countries[c(0:10),c("adm0_a3_is", "label","Code2","Label2")], row.names = F, digits = 1)| adm0_a3_is | label | Code2 | Label2 | geom |
|---|---|---|---|---|
| BGR | Bulgaria | 923 | Eastern Europe | MULTIPOLYGON (((-1882818 -4… |
| MMR | Myanmar | 920 | South-Eastern Asia | MULTIPOLYGON (((5416951 -56… |
| BDI | Burundi | 910 | Eastern Africa | MULTIPOLYGON (((-3418256 -9… |
| BLR | Belarus | 923 | Eastern Europe | MULTIPOLYGON (((-1406024 -3… |
| KHM | Cambodia | 920 | South-Eastern Asia | MULTIPOLYGON (((7198820 -51… |
| DZA | Algeria | 912 | Northern Africa | MULTIPOLYGON (((-3911770 -4… |
| CMR | Cameroon | 911 | Middle Africa | MULTIPOLYGON (((-5196562 -7… |
| CAN | Canada | 918 | Northern America | MULTIPOLYGON (((-2925928 15… |
| CPV | Cabo Verde | 914 | Western Africa | MULTIPOLYGON (((-7996256 -2… |
| CYM | Cayman Islands | 915 | Caribbean | MULTIPOLYGON (((-5899896 51… |
Géométries
subregions <-
aggregate(countries, by = list(countries$Code2), FUN = head, 1)
subregions <- subregions[, c("Code2", "Label2")]
st_geometry(subregions) <-
st_cast(subregions$geometry, "MULTIPOLYGON")
colnames(subregions) <- c("id", "label", "geometry")template("Subregions", "maps/subregions.png")
mf_map(
subregions,
col = "#4e4f4f",
border = col,
lwd = 0.5,
add = TRUE
)
mf_label(
x = subregions,
var = "label",
halo = TRUE,
bg = "#4e4f4f",
cex = 0.8,
col = col,
overlap = TRUE,
lines = FALSE
)
dev.off()Données attributaires
keys <- data.frame(countries[, c("adm0_a3_is", "Code2")])
keys$geom <- NULL
migr <- merge(x = migr,
y = keys,
by.x = "i",
by.y = "adm0_a3_is")
colnames(migr)[4] <- "subreg_i"
migr <- merge(x = migr,
y = keys,
by.x = "j",
by.y = "adm0_a3_is")
colnames(migr)[5] <- "subreg_j"
migr$id <- paste0(migr$subreg_i, "_", migr$subreg_j)
migr2 <- aggregate(migr$fij, by = list(migr$id), FUN = sum)
migr2$i <- sapply(strsplit(migr2$Group.1, "_"), "[", 1)
migr2$j <- sapply(strsplit(migr2$Group.1, "_"), "[", 2)
migr2 <- migr2[, c("i", "j", "x")]
colnames(migr2)[3] <- "fij"
migr2$fij <- round(migr2$fij / 1000, 0)knitr::kable(migr2[c(0:10),], row.names = F, digits = 1)| i | j | fij |
|---|---|---|
| 5500 | 5500 | 483 |
| 5500 | 5501 | 12 |
| 5500 | 906 | 28 |
| 5500 | 912 | 4 |
| 5500 | 913 | 0 |
| 5500 | 914 | 2 |
| 5500 | 915 | 0 |
| 5500 | 916 | 0 |
| 5500 | 918 | 137 |
| 5500 | 922 | 95 |
On ajoute au fond de carte les flux intrarégionaux
flowsintra <- migr2[migr2$i == migr2$j,c("i","fij")]
colnames(flowsintra) <- c("id","intra")
subregions <- merge(x = subregions, y = flowsintra, by = "id")knitr::kable(subregions[c(0:10),], row.names = F, digits = 1)| id | label | intra | geometry |
|---|---|---|---|
| 906 | Eastern Asia | 5202 | MULTIPOLYGON (((5080366 475… |
| 910 | Eastern Africa | 5330 | MULTIPOLYGON (((-5355748 -1… |
| 911 | Middle Africa | 1537 | MULTIPOLYGON (((-6834732 -7… |
| 912 | Northern Africa | 351 | MULTIPOLYGON (((-6292518 -3… |
| 913 | Southern Africa | 715 | MULTIPOLYGON (((-7411330 -1… |
| 914 | Western Africa | 6625 | MULTIPOLYGON (((-9729228 -6… |
| 915 | Caribbean | 864 | MULTIPOLYGON (((-8249499 32… |
| 916 | Central America | 641 | MULTIPOLYGON (((-7273542 55… |
| 918 | Northern America | 1114 | MULTIPOLYGON (((-5837264 26… |
| 920 | South-Eastern Asia | 6856 | MULTIPOLYGON (((5449694 -56… |
Calcul des interactions inter régionales (A -> B) + (B -> A)
migr2 <- migr2[migr2$i != migr2$j,]
for (k in 1:length(migr2$i)) {
val1 <- migr2$fij[k]
val2 <-
migr2[migr2$i == migr2$j[k] & migr2$j == migr2$i[k], "fij"]
migr2$interaction[k] <- sum(val1, val2)
}
# Suppression des doublons
interactions = data.frame(matrix(
ncol = 3,
nrow = 0,
dimnames = list(NULL, c("i", "j", "interaction"))
))
for (k in 1:length(migr2$i)) {
idi = migr2$i[k]
idj = migr2$j[k]
test = length(interactions[(interactions$i == idi &
interactions$j == idj) |
(interactions$i == idj & interactions$j == idi), "interaction"])
if (test == 0) {
interactions <-
rbind(interactions, data.frame(
i = idi,
j = idj,
interaction = migr2$interaction[k]
))
}
}knitr::kable(interactions[c(0:10),], row.names = F, digits = 1)| i | j | interaction |
|---|---|---|
| 5500 | 5501 | 28 |
| 5500 | 906 | 130 |
| 5500 | 912 | 4 |
| 5500 | 913 | 0 |
| 5500 | 914 | 2 |
| 5500 | 915 | 0 |
| 5500 | 916 | 0 |
| 5500 | 918 | 137 |
| 5500 | 922 | 261 |
| 5500 | 923 | 9999 |
On élimine les petits flux
threshold <- 2000
interactions <- interactions[interactions$interaction >= threshold,]Calcul des liens
links <-
mf_get_links(
x = subregions,
df = interactions,
x_id = "id",
df_id = c("i", "j")
)Cartographie
template("L'Arique, un continent encore isolé dans la mondialisation", "maps/heran.png")
col2 = "#4e4f4f"
mf_map(
subregions,
col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
mf_map(
links,
var = "interaction",
col = col,
border = "#3b3b3b",
type = "prop",
lwd_max = 25,
leg_pos = "bottomleft",
leg_title = paste0("Migratons INTER régionales (interactions)\n(A -> B) + (B -> A)\nSeuil : ",threshold, "\nen milliers de personnes"),
add = TRUE
)
mf_map(
subregions,
var = "intra",
col = "#3b3b3b",
border = col,
lwd = 1.5,
type = "prop",
symbol = "square",
leg_pos = "topright",
leg_title = "Migrations INTRA\nrégionale nen 2019\n(en milliers)",
add = TRUE
)
mf_label(
subregions,
var = "intra",
halo = FALSE,
cex = sqrt(as.numeric(subregions$intra) / 12000),
col = col,
overlap = TRUE,
lines = FALSE
)
mf_label(
links,
var = "interaction",
halo = TRUE,
cex = 0.5,
col = col2,
bg = col,
r = 0.1,
overlap = FALSE,
lines = FALSE
)
dev.off()Problème : avec seulement mapsf, on a du mal à représenter des flêches et surtout, à la fois des flêches A -> B et B -> A. La solution : Flowmapper 👍
Flowmapper
flowmapper() est une fonction du package ttt (en cours de développement).
library(ttt)La fonction ttt_flowmapper() prends plusieurs arguements :
…
Les données
Dans le package ttt, il y a des données d’exemple au niveau subrégional. Chargeons-les.
subregions <- st_read(system.file("subregions.gpkg", package="flowmapper")) %>% st_transform(crs)
migr <- read.csv(system.file("migrantstocks2019.csv", package="flowmapper"))On ne consrve que les flux importants
threshold <- 1500
migr <- migr[migr$fij >= threshold, ]knitr::kable(migr[c(0:10),], row.names = F, digits = 1)| i | j | fij |
|---|---|---|
| 5500 | 923 | 5603 |
| 5501 | 5501 | 11177 |
| 5501 | 918 | 5334 |
| 5501 | 920 | 1666 |
| 5501 | 922 | 18402 |
| 5501 | 924 | 2551 |
| 906 | 906 | 5202 |
| 906 | 918 | 5700 |
| 910 | 910 | 5330 |
| 910 | 913 | 1538 |
flows <- ttt_flowmapper(
x = subregions,
xid = "id",
df = migr,
dfid = c("i", "j"),
dfvar = "fij",
plot = FALSE
)Liens
template("ttt_flowmapper$links", "maps/ttt_links.png")
mf_map(
subregions,
col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
mf_map(flows$links,
col = col,
lwd = 3,
add = TRUE)
dev.off()Cercles
template("ttt_flowmapper$circles", "maps/ttt_circles.png")
mf_map(
subregions,
col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
mf_map(flows$circles, col = col, add = TRUE)
dev.off()Flêches
template("ttt_flowmapper$flows", "maps/ttt_flows.png")
mf_map(
subregions,
col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
mf_map(flows$flows, col = col, add = TRUE)
dev.off()Visualisation par défaut
template("flowmappze", "maps/ttt_flows.png")
mf_map(
subregions,
col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
flows <- ttt_flowmapper(
x = subregions,
xid = "id",
type = "arrows",
df = migr,
dfid = c("i", "j"),
dfvar = "fij",
col = col,
border = "#424242",
border2 = col,
add = TRUE
)
ttt_flowmapperlegend(x = flows, title = "Flux", col = col)
dev.off()La VV taille, c’est aussi la surface
template("La surface des fleches", "maps/ttt_surface.png")
mf_map(
subregions,
col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
ttt_flowmapper(
x = subregions,
xid = "id",
type = "arrows",
size = "area",
df = migr,
dfid = c("i", "j"),
dfvar = "fij",
col = col,
border = "#424242",
border2 = col,
add = TRUE
)
dev.off()Epaisseur vs Surface
Interactions (type = “rect”)
migr2 <- data.frame(i = integer(), j = integer(), fij = integer())
for (k in 1:length(migr$i)) {
val1 <- migr$fij[k]
val2 <- migr[migr$i == migr$j[k] & migr$j == migr$i[k], "fij"]
val <- sum(val1, val2)
idi = migr$i[k]
idj = migr$j[k]
test <-
length(migr2[(migr2$i == idi &
migr2$j == idj) | (migr2$i == idj & migr2$j == idi), "fij"])
if (test == 0) {
migr2 <- rbind(migr2, data.frame(i = idi, j = idj, fij = val))
}
}
migr2 <- migr2[migr2$i != migr2$j, ] head(migr2)## i j fij
## 1 5500 923 9999
## 3 5501 918 5334
## 4 5501 920 3221
## 5 5501 922 18402
## 6 5501 924 2551
## 8 906 918 5700
template("tInteractions", "maps/ttt_interactions.png")
c <- ttt_flowmapper(
x = subregions,
xid = "id",
size = "thickness",
type = "rect",
df = migr2,
dfid = c("i", "j"),
dfvar = "fij",
col = col,
border = "#424242",
border2 = col,
add = TRUE
)
dev.off()Combiner flux intra et flux inter
intra <- migr[migr$i == migr$j, ]
intra <- intra[, c("i", "fij")]
colnames(intra) <- c("id", "nb")
knitr::kable(intra, row.names = F, digits = 1)template("Flux inter et flux intra", "maps/interintra.png")
flows <- ttt_flowmapper(
x = subregions,
xid = "id",
df = migr,
dfid = c("i", "j"),
dfvar = "fij",
size = "thickness",
type = "arrows",
decreasing = FALSE,
add = TRUE,
lwd = 1,
col = col,
border = "#424242",
k = NULL,
k2 = 60,
df2 = intra,
df2id = "id",
df2var = "nb",
col2 = "#eb4034",
border2 = "#424242"
)
dev.off()Reprojection
1 - calcul en projection polaire
tmp <- ttt_flowmapper(
x = subregions,
xid = "id",
type = "arrows",
df = migr,
dfid = c("i", "j"),
dfvar = "fij",
col = "#ffc524",
border = "#424242",
border2 = "#ffc524",
plot = FALSE
)2 - reprojection & nouveau template
crs <-
"+proj=ortho +lat_0=42.5333333333 +lon_0=-72.53333333339999 +x_0=0 +y_0=0 +a=6370997 +b=6370997 +units=m +no_defs"
flows <- smoothr::densify(tmp$flows, n = 30) %>% st_transform(crs)
dots <- st_transform(tmp$circles, crs)
subregions <- st_transform(subregions, crs)
graticule <- st_transform(graticule, crs)
bbox <- st_transform(bbox, crs)3 - affichage
title = "Flux sur Globe"
file = "maps/ttt_globe.png"
mf_export(
subregions,
export = "png",
width = 1000,
filename = file,
res = 96,
theme = theme,
expandBB = c(-.02, 0,-.02, 0)
)
mf_map(
bbox,
col = "#3b3b3b",
border = NA,
lwd = 0.5,
add = TRUE
)
mf_map(graticule,
col = "#FFFFFF50",
lwd = 0.5,
add = TRUE)
mf_map(
subregions,
col = "#4e4f4f",
border = "#3b3b3b",
lwd = 0.5,
add = TRUE
)
mf_credits(
txt = credit,
pos = "bottomright",
col = "#1a2640",
cex = 0.7,
font = 3,
bg = "#ffffff30"
)
mf_map(flows, col = col, add = TRUE)
mf_map(dots, col = col, add = TRUE)
mf_title(title)
dev.off()Visualiser R/Shiny
https://gitlab.huma-num.fr/nlambert/migrexplorer3/-/tree/master